Linux Cubed Series 3: Developer Tools/Linux Cubed Series 3 - Developer Tools.iso/devel/lang/lisp/glisp/glisp.000/GLISP.UNIX.TAR/closunix/clos_lfg.c

C/C++ Source or Header | 1995-04-03 | 4.3 KB | 258 lines

/*                 GRAPHIC LISP            */
/*        Scritto nel 1991-94 da Zoia Andrea Michele     */
/*        Via Pergola #1 Tirano (SO) Tel. [phone]    */
/* file clos_lfg.c */

#include "clos.h"

#define chkgr()                            \
  if(!lg_graphopen()){                        \
    nout->node=NIL;                        \
    nout->type=P_ALLNODE;                                       \
    return;                                                     \
  }                                                             \

#define getinit()                        \
  node n;                                                       \
  node ni=nin                                                   \

#define getint(v)                        \
  if(!IS_CONS(nin))                                             \
    error(E_FEWARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&ni);        \
  eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);            \
  n=calc_pointer(nout);                        \
  if(!IS_VALUE(n) || !(GET_VTYPE(n)==NT_INTEGER) )              \
    error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&n);         \
  v=INTEGER(n);                            \
  nin=CONSRIGHT(nin);

#define getstring(v)                        \
  if(!IS_CONS(nin))                                             \
    error(E_FEWARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&ni);        \
  eval(CONSLEFT(nin),nout,genv,lenv,EVAL_NORM);            \
  n=calc_pointer(nout);                        \
  if(!IS_VALUE(n) || !(GET_VTYPE(n)==NT_STRING) )               \
    error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&n);         \
  v=STRING(n);                            \
  nin=CONSRIGHT(nin);


node intlist(x,y)
n_int x,y;
{
 node c1,c2,r1,r2;

 c1=node_make();
 c2=node_make();
 r1=node_make();
 r2=node_make();

 TYPE(r1)=TYPE(r2)|=NT_IS_VALUE+NT_INTEGER;
 TYPE(c1)=TYPE(c2)|=NT_IS_CONS;

 INTEGER(r1)=x;
 INTEGER(r2)=y;

 CONSLEFT(c1)=r1;
 CONSRIGHT(c1)=c2;
 CONSLEFT(c2)=r2;
 CONSRIGHT(c2)=NIL;

 return c1;

}

void lf_graphopen LF_PARAMS
{
 getinit();
 int m,row=0,col=0;

 getint(m);
 if(m!=0 && lg_graphopen()){
   lg_opengraph(0,&row,&col);
 }
 lg_opengraph(m,&row,&col);
 nout->node=intlist((n_int)col,(n_int)row);
 nout->type=P_ALLNODE;
}

void lf_graphclear LF_PARAMS
{
 nout->node=lg_graphopen()?(lg_cleargraph(),T):NIL;
 nout->type=P_ALLNODE;
}


void lf_gpencolor LF_PARAMS
{
 getinit();
 long c;

 chkgr();
 getint(c);
 lg_pencolor(c);
}

void lf_gpentick LF_PARAMS
{
 getinit();
 int t;

 chkgr();
 getint(t);
 lg_pentick(t);
}

void lf_gpentype LF_PARAMS
{
 getinit();
 int t;

 chkgr();
 getint(t);
 lg_pentype(t);
}


void lf_gbrushcolor LF_PARAMS
{
 getinit();
 long c;

 chkgr();
 getint(c);
 lg_brushcolor(c);
}

void lf_gbrushtype LF_PARAMS
{
 getinit();
 int t;

 chkgr();
 getint(t);
 lg_brushtype(t);
}

void lf_gputpixel LF_PARAMS
{
 getinit();
 int x,y,c;

 chkgr();
 getint(x);getint(y);getint(c);
 lg_putpixel(x,y,c);
}


void lf_ggetpixel LF_PARAMS
{
 getinit();
 int x,y;

 chkgr();
 getint(x);getint(y);
 nout->type=P_ALLNODE;
 nout->node=node_make();
 TYPE(nout->node)|=NT_IS_VALUE+NT_INTEGER;
 INTEGER(nout->node)=lg_getpixel(x,y);
}




void lf_gmoveto LF_PARAMS
{
 getinit();
 int x,y;

 chkgr();
 getint(x);getint(y);
 lg_moveto(x,y);
}

void lf_glineto LF_PARAMS
{
 getinit();
 int x,y;

 chkgr();
 getint(x);getint(y);
 lg_lineto(x,y);
}




void lf_gfillpoly LF_PARAMS
{
 getinit();
 int pts;
 static int *points=NULL;
 /* NB: è statico perchè se si alloca un array e poi avviene un errore
    l'array non viene più disallocato da questa chiamata a fillpoly
    l'array verrà disallocato dalla chiamata successiva, prima di essere
    nuovamente riallocato */
 int i;

 chkgr();
 getint(pts);
 if(pts<1)
   error(E_BADARGS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&CONSLEFT(ni));
 if(points)free((void*)points);
 points=(int *)malloc(pts*sizeof(int)*2);
 if(points==NULL)
   error(E_NOMEMPOINTS,ERR_MERROR|ERR_TBLVL|ERR_PNODE,&CONSLEFT(ni));
 for(i=0;i<pts;i++){
   getint(points[i*2  ]);
   getint(points[i*2+1]);
 }
 lg_fillpoly(pts,points);
 free((void*)points);
 points=NULL;
}

void lf_gfillsector LF_PARAMS
{
 getinit();
 int x,y,sa,ea,xr,yr;

 chkgr();
 getint(x);getint(y);getint(sa);getint(ea);getint(xr);getint(yr);
 lg_fillsector(x,y,sa,ea,xr,yr);
}

void lf_gfillellipse LF_PARAMS
{
 getinit();
 int x,y,xr,yr;

 chkgr();
 getint(x);getint(y);getint(xr);getint(yr);
 lg_fillellipse(x,y,xr,yr);
}

void lf_gouttext LF_PARAMS
{
 getinit();
 int x,y;
 str_t s;

 chkgr();
 getint(x);getint(y);getstring(s);
 lg_graphtext(x,y,string_get(s,buf1));
}